home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 038a / bas_int1.zip / ATTRIB.BAS < prev    next >
BASIC Source File  |  1991-03-02  |  9KB  |  130 lines
  1. '===========================================================================
  2. '   Date : 27-Feb-91  1:06
  3. '   From : Frank Rakoczy
  4. 'Subject : ATTRIBUTES
  5. '
  6. 'You can use dosfn 43h subfunction 0 to read file attributes or sub
  7. 'function 1 to set or clear file attributes.
  8. '===========================================================================
  9.  
  10. DECLARE FUNCTION FileAttrib% (Action AS INTEGER, Attrib AS INTEGER,_    
  11.                               PathName AS STRING)
  12.                                                                         
  13. ' $INCLUDE: 'qb.bi'            'needed for definition or RegTypeX and
  14. '                               DECLARE statement for interruptX        
  15. '                                                                       
  16. 'Define legal actions for function FileAttrib                           
  17.                                                                         
  18. CONST GetAttrib% = 0, SetAttrib% = 1                                    
  19.  
  20. 'Define bit flags for file attributes. Note that dosfn 43h will upchuck 
  21. 'if you try set the volume label bit (bit 3) or the directory bit       
  22. '(bit 4) of an existing file. These bits have not been defined below.   
  23. '                                                                       
  24. CONST Areadonly% = &H1, Ahidden = &H2, Asystem = &H4, Aarchive = &H20   
  25.  
  26. '-----------------------------------------------------------------------
  27. '--- A small piece of test code
  28. DIM Attrib AS INTEGER      'set up a couple of variables                
  29. PathName$ = "Phantom.Fil"                                               
  30.                                                                         
  31. OPEN PathName$ FOR OUTPUT AS #1       'open a file and throw some       
  32. PRINT #1, "Now You See Me -- Now You Don't"   'trash in it              
  33. CLOSE #1                                      'close it                 
  34. CLS                                                                     
  35. PRINT "Now You See Me"   'see if it exists                              
  36. FILES "*.fil"                                                           
  37. PRINT                                                                   
  38. 'mark file as hidden -- call function to get current file attributes    
  39.                                                                         
  40. Attrib = FileAttrib(GetAttrib, 0, PathName$)                            
  41.                                                                         
  42. 'call again to set attributes to current + hidden                       
  43.                                                                         
  44. Attrib = FileAttrib(SetAttrib, Attrib OR Ahidden, PathName$)            
  45. '                                                                       
  46. 'if you wish you can check for errors after each call                   
  47. 'IF Attrib < 0 THEN GOSUB ERRRCHK                                       
  48. '                                                                       
  49. PRINT "The Phantom File has now gone South"                             
  50. ON ERROR GOTO NEXT1    'The call to Files will generate an error here   
  51. FILES "*.fil"          'because the file has been marked hidden in the  
  52. PRINT                  'previous call to FileAttrib%()                  
  53. NEXT1:                                                                  
  54. RESUME NEXT                                                             
  55. 'turn off hidden bit  -- get the file' current attributes               
  56.                                                                         
  57. Attrib = FileAttrib(GetAttrib, 0, PathName$)                            
  58.                                                                         
  59. 'call FileAttrib to turn off hidden bit                                 
  60.                                                                         
  61. Attrib = FileAttrib(SetAttrib, Attrib - Ahidden, PathName$)             
  62.                                                                         
  63. PRINT "The Phantom has returned"                                        
  64. FILES "*.fil"                                                           
  65. '                                                                       
  66. 'ERRCHK:                                                                
  67. 'Attrib = Attrib AND &H7F  'convert return value to error code          
  68. ' .                                                                     
  69. ' .     and take any necessary corrective action here                   
  70. ' .                                                                     
  71. 'RETURN                                                                 
  72. '                                                                       
  73. 'END OF TEST CODE -- TRASH THIS WHEN YOU UNDERSTAND THE FUNCTION              
  74. '-------------------------------------------------------------------------    
  75.                                                                               
  76.                                                                               
  77.                                                                               
  78. FUNCTION FileAttrib% (Action AS INTEGER, Attrib AS INTEGER,_                  
  79.                       PathName AS STRING)
  80. DIM r AS RegTypeX                                                             
  81.                                                                               
  82. 'The dosfn expects the address of an ASCIIZ pathname and this is not the      
  83. 'string format used by basic. So copy the PathName argument to a temporary    
  84. 'string and append chr$(0) to the original PathName.                          
  85.                                                                               
  86. Temp$ = PathName$ + CHR$(0)                                                   
  87.                                                                               
  88. r.ax = &H4300 + Action   'AH gets 43h and AL gets action (set or get)         
  89. r.cx = Attrib            'load requested attribute into cx                    
  90.                                                                               
  91. 'dosfn 43h expects ds:dx to point to the asciiz path name of the file.        
  92. 'NOTE: The coding below takes into account the possibility of the temporary   
  93. 'path name string being in a far data segment. As far a I know, Basic's       
  94. 'internal memory management routines do everything possible to keep this      
  95. 'from happening. You should be able to implement this code using call         
  96. 'interrupt and load r.dx with sadd(temp$). Then you won't have to worry       
  97. 'about messing with the segment registers.                                    
  98.                                                                             
  99.                                                                             
  100. r.ds = VARSEG(Temp$)    'load DS with segment address                       
  101. r.dx = SADD(Temp$)'load DX with offset address                              
  102. r.es = -1               'use current value of es                            
  103.                                                                             
  104. CALL INTERRUPTX(&H21, r, r)  'call dos to perform requested operation       
  105.                                                                             
  106. 'Dos will return the carry flag clear if the call was successful. If        
  107. 'there was an error the cflag will be set. You can check this condition     
  108. 'and adjust the return value accordingly. For the purposes of this demo     
  109. 'I will use the following method:                                           
  110. 'If cflag = 0 then return the attribute. If cflag is non zero then r.ax     
  111. 'contains a dos error code. Because the value of the err code or the        
  112. 'attribute will always be a positive value we can get away with the         
  113. 'following.                                                                 
  114.                                                                             
  115. IF r.flags AND &H1 THEN    'if carry flag is set then an error occurred     
  116.                                                                             
  117. FileAttrib% = r.ax AND &H80                                                 
  118.                                                                             
  119. 'return the error code forced to a negative value. The calling module can   
  120. 'check the return value for a < 0 condition and detect any error. To        
  121. 'change the return value to the proper error code the calling module can    
  122. 'AND the return value with &H7F and the value will be the error code        
  123. 'returned by DOS. The calling module can then take any required action   
  124.                                                                          
  125. ELSE               'no error so return attribute                         
  126. FileAttrib% = r.cx                                                       
  127. END IF                                                                   
  128.                                                                          
  129. END FUNCTION                                                             
  130.